﻿module FSChart.MSChart

module MetafileToClipboard =
    module private Intern =
        open System
        open System.Runtime.InteropServices
        
        [<DllImport("user32.dll")>]
        extern bool OpenClipboard(IntPtr hWndNewOwner)
        [<DllImport("user32.dll")>]
        extern bool EmptyClipboard()
        [<DllImport("user32.dll")>]
        extern IntPtr SetClipboardData(uint32 uFormat, IntPtr hMem)
        [<DllImport("user32.dll")>]
        extern bool CloseClipboard()
        [<DllImport("gdi32.dll")>]
        extern IntPtr CopyEnhMetaFile(IntPtr hemfSrc, IntPtr hNULL)
        [<DllImport("gdi32.dll")>]
        extern bool DeleteEnhMetaFile(IntPtr hemf)
    
    open Intern
    open System
    
    let PutEnhMetafileOnClipboard(hWnd:IntPtr, mf:System.Drawing.Imaging.Metafile) =
        let mutable bResult = false
        let hEMF = mf.GetHenhmetafile()
        
        if not <| hEMF.Equals(new IntPtr(0)) then
            let hEMF2 = CopyEnhMetaFile(hEMF, new IntPtr(0))
            if not <| hEMF2.Equals(new IntPtr(0)) then
                if OpenClipboard(hWnd) then
                    if EmptyClipboard() then
                        let hRes = SetClipboardData(uint32 14, hEMF2)
                        let bResult = hRes.Equals(hEMF2)
                        CloseClipboard() |> ignore
            DeleteEnhMetaFile(hEMF) |> ignore
        bResult

open Helpers

open System.IO
open System.Drawing
open System.Windows.Forms
open System.Windows.Forms.DataVisualization.Charting

type IEnumerable = System.Collections.IEnumerable

let chartType = function
    | Line          -> SeriesChartType.Line
    | FastLine      -> SeriesChartType.FastLine
    | StepLine      -> SeriesChartType.StepLine
    | Scatter       -> SeriesChartType.Point
    | FastPoint     -> SeriesChartType.FastPoint
    | Bar         _ -> SeriesChartType.Column
    | BarH        _ -> SeriesChartType.Bar
    | StackedBar  _ -> SeriesChartType.StackedColumn
    | StackedBarH _ -> SeriesChartType.StackedBar
    | Candlestick _ -> SeriesChartType.Candlestick
    | OHLC          -> SeriesChartType.Stock
    | FilledArea    -> SeriesChartType.Area
    | StackedArea   -> SeriesChartType.StackedArea
    | Band          -> SeriesChartType.Range
    | Spline      _ -> SeriesChartType.Spline
    | SplineArea  _ -> SeriesChartType.SplineArea
    | SplineBand  _ -> SeriesChartType.SplineRange
    | Pie           -> SeriesChartType.Pie
    | Polar         -> SeriesChartType.Polar
    | Radar         -> SeriesChartType.Radar
    | RadarArea   _ -> SeriesChartType.Radar

let axisType = function
    | Primary   -> AxisType.Primary
    | Secondary -> AxisType.Secondary

let docking = function
    | Top    -> Docking.Top
    | Bottom -> Docking.Bottom
    | Left   -> Docking.Left
    | Right  -> Docking.Right

let alignment = function
    | Near   -> StringAlignment.Near
    | Center -> StringAlignment.Center
    | Far    -> StringAlignment.Far

let contentAlignment = function
    | true , Near   -> ContentAlignment.BottomLeft
    | true , Center -> ContentAlignment.BottomCenter
    | true , Far    -> ContentAlignment.BottomRight
    | false, Near   -> ContentAlignment.BottomCenter
    | false, Center -> ContentAlignment.MiddleCenter
    | false, Far    -> ContentAlignment.TopCenter

let orientation = function
    | Horizontal _ -> AreaAlignmentOrientations.Horizontal
    | Vertical   _ -> AreaAlignmentOrientations.Vertical

let markerStyle = function
    | Triangle -> MarkerStyle.Triangle
    | Square   -> MarkerStyle.Square
    | Diamond  -> MarkerStyle.Diamond
    | Circle   -> MarkerStyle.Circle
    | Cross    -> MarkerStyle.Cross
    | Star     -> MarkerStyle.Star5

let dashStyle = function
    | Solid      -> ChartDashStyle.Solid
    | Dot        -> ChartDashStyle.Dot
    | Dash       -> ChartDashStyle.Dash
    | DashDot    -> ChartDashStyle.DashDot
    | DashDotDot -> ChartDashStyle.DashDotDot

let createTitle (chart : Chart) (titleD : TitleDef) =
    
    let title = new Title()
    title.Text <- titleD.Text
    title.Docking <- docking titleD.Location
    
    let standard =
        match titleD.Horizontal, titleD.Location with
        | false, _      -> true
        | true , Top    -> true
        | true , Bottom -> true
        | _             -> false
    
    title.Alignment <- contentAlignment (standard, titleD.Alignment)
    if titleD.Horizontal then title.TextOrientation <- TextOrientation.Horizontal
    
    match titleD.Color with
    | None -> () | Some c -> title.ForeColor <- c
    
    match titleD.Font with
    | None -> () | Some (nm, sz, sty) -> title.Font <- new Font(nm, sz, sty)
    
    match titleD.Border with
    | None -> ()
    | Some (s, c, w) ->
        title.BorderDashStyle <- dashStyle s
        title.BorderColor <- c
        title.BorderWidth <- w
    
    match titleD.Background with
    | None -> ()
    | Some ( Uniform c ) ->
        title.BackGradientStyle <- GradientStyle.None
        title.BackColor <- c
    | Some ( Gradient(c1, c2) ) ->
        title.BackGradientStyle <- GradientStyle.TopBottom
        title.BackColor <- c1
        title.BackSecondaryColor <- c2
    
    chart.Titles.Add title
    title

let setChart (chart : Chart) (chartD : ChartDef) =
    
    match chartD.Title with
    | None -> () | Some titleD -> createTitle chart titleD |> ignore
    
    match chartD.Border with
    | None -> ()
    | Some (s, c, w) ->
        chart.BorderDashStyle <- dashStyle s
        chart.BorderColor <- c
        chart.BorderWidth <- w
    
    match chartD.Background with
    | None -> ()
    | Some ( Uniform c ) ->
        chart.BackGradientStyle <- GradientStyle.None
        chart.BackColor <- c
    | Some ( Gradient(c1, c2) ) ->
        chart.BackGradientStyle <- GradientStyle.TopBottom
        chart.BackColor <- c1
        chart.BackSecondaryColor <- c2

let createLegend (chart : Chart) (legendD : LegendDef) name =
    
    let legend = new Legend()
    legend.Name <- name
    legend.DockedToChartArea <- name
    legend.Docking <- docking legendD.Location
    legend.Alignment <- alignment legendD.Alignment
    legend.IsDockedInsideChartArea <- legendD.Inside
    
    match legendD.Color with
    | None -> () | Some c -> legend.ForeColor <- c
    
    match legendD.Font with
    | None -> () | Some (nm, sz, sty) -> legend.Font <- new Font(nm, sz, sty)
    
    match legendD.Border with
    | None -> ()
    | Some (s, c, w) ->
        legend.BorderDashStyle <- dashStyle s
        legend.BorderColor <- c
        legend.BorderWidth <- w
    
    match legendD.Background with
    | None -> ()
    | Some ( Uniform c ) ->
        legend.BackGradientStyle <- GradientStyle.None
        legend.BackColor <- c
    | Some ( Gradient(c1, c2) ) ->
        legend.BackGradientStyle <- GradientStyle.TopBottom
        legend.BackColor <- c1
        legend.BackSecondaryColor <- c2
    
    chart.Legends.Add legend

let setAxis (chart : Chart) (axis : Axis) (axisD : AxisDef) =
    
    axis.Enabled <- AxisEnabled.True
    axis.IsReversed <- axisD.Reversed
    axis.IsMarginVisible <- axisD.Margin
    axis.IsStartedFromZero <- false
    axis.MajorTickMark.Enabled <- axisD.Ticks
    
    match axisD.Title with
    | None -> ()
    | Some titleD ->
        axis.Title <- titleD.Text
        axis.TitleAlignment <- alignment titleD.Alignment
        if titleD.Horizontal then axis.TextOrientation <- TextOrientation.Horizontal
        match titleD.Color with
        | None -> () | Some c -> axis.TitleForeColor <- c
        match titleD.Font with
        | None -> () | Some (nm, sz, sty) -> axis.TitleFont <- new Font(nm, sz, sty)
    
    match axisD.Grid with
    | None ->
        axis.MajorGrid.Enabled <- false
    | Some gridD ->
        axis.MajorGrid.Enabled <- true
        match gridD.Pen with
        | None -> ()
        | Some (s, c, w) ->
            axis.MajorGrid.LineDashStyle <- dashStyle s
            axis.MajorGrid.LineColor <- c
            axis.MajorGrid.LineWidth <- w
    
    match axisD.Labels with
    | None ->
        axis.LabelStyle.Enabled <- false
    | Some labelD ->
        axis.LabelStyle.Enabled <- true
        match labelD.Format with
        | None -> () | Some f -> axis.LabelStyle.Format <- f
        match labelD.Color with
        | None -> () | Some c -> axis.LabelStyle.ForeColor <- c
        match labelD.Font with
        | None ->
            axis.IsLabelAutoFit <- true
        | Some (nm, sz, sty) ->
            axis.LabelStyle.Font <- new Font(nm, sz, sty)
            axis.IsLabelAutoFit <- labelD.AutoFit
            axis.LabelAutoFitMaxFontSize <- int sz
        match labelD.Angle with
        | None -> () | Some a -> axis.LabelStyle.Angle <- a
    
    match axisD.Pen with
    | None -> ()
    | Some (s, c, w) ->
        axis.LineDashStyle <- dashStyle s
        axis.LineColor <- c
        axis.LineWidth <- w
        axis.MajorTickMark.LineColor <- c

let createArea (chart : Chart) (areaD : AreaDef) (x, y, w, h) (name : string) =
    
    let area = chart.ChartAreas.Add(name)
    
    if (x, y, w, h) <> (0.0, 0.0, 1.0, 1.0) then
        let f x = 100.0f * float32 x
        let x, y, w, h = (f x, f y, f w, f h)
        area.Position <- new ElementPosition(x, y, w, h)
    
    match areaD.Title with
    | None -> ()
    | Some titleD ->
        let title = createTitle chart titleD
        title.DockedToChartArea <- name
        title.IsDockedInsideChartArea <- titleD.Inside
    
    match areaD.Style3D with
    | None -> ()
    | Some style3D ->
        let (perspective, roty, rotx) = style3D.View
        let (depth, gap) = style3D.Depth
        area.Area3DStyle.Enable3D <- true
        area.Area3DStyle.Perspective <- perspective
        area.Area3DStyle.Rotation <- roty
        area.Area3DStyle.Inclination <- rotx
        area.Area3DStyle.PointDepth <- depth
        area.Area3DStyle.PointGapDepth <- gap
        area.Area3DStyle.WallWidth <- style3D.Wall
        area.Area3DStyle.IsClustered <- false
        area.Area3DStyle.LightStyle <- if style3D.Realism then LightStyle.Realistic else LightStyle.Simplistic
    
    setAxis chart area.AxisX areaD.AxisX
    setAxis chart area.AxisY areaD.AxisY
    
    match areaD.AxisY2 with
    | None -> ()
    | Some axisD -> setAxis chart area.AxisY2 axisD
    
    match areaD.Legend with
    | None -> ()
    | Some legendD -> createLegend chart legendD name
    
    match areaD.Border with
    | None -> ()
    | Some (s, c, w) ->
        area.BorderDashStyle <- dashStyle s
        area.BorderColor <- c
        area.BorderWidth <- w
    
    match areaD.Background with
    | None -> ()
    | Some ( Uniform c ) ->
        area.BackGradientStyle <- GradientStyle.None
        area.BackColor <- c
    | Some ( Gradient(c1, c2) ) ->
        area.BackGradientStyle <- GradientStyle.TopBottom
        area.BackColor <- c1
        area.BackSecondaryColor <- c2
    
    area

let createSeries (chart : Chart) (areaD : AreaDef) areaName (seriesD : SeriesDef) (data : SeriesData) name =
    
    let series = new Series()
    series.Name      <- name
    series.ChartArea <- areaName
    series.ChartType <- chartType seriesD.SeriesType
    series.YAxisType <- axisType seriesD.AxisY
    series.IsXValueIndexed <- match areaD.AxisX.Scale with Some( TimeX _ ) -> true | _ -> false
    
    match seriesD.SeriesType with
    | Bar w | BarH w | StackedBar w | StackedBarH w | Candlestick w -> series.["PointWidth"] <- string w
    | Spline t | SplineArea t | SplineBand t -> series.["LineTension"] <- string t
    | Polar     -> series.["PolarDrawingStyle"] <- "Line"
    | Radar     -> series.["RadarDrawingStyle"] <- "Line"
    | RadarArea -> series.["RadarDrawingStyle"] <- "Area"
    | _ -> ()
    
    match seriesD.Color with
    | None -> () | Some c -> series.Color <- c
    
    match seriesD.Border with
    | None -> ()
    | Some (s, c, w) ->
        series.BorderDashStyle <- dashStyle s
        series.BorderColor <- c
        series.BorderWidth <- w
        match seriesD.SeriesType with
        | Line | FastLine | StepLine | Spline _ | Polar | Radar
            -> series.Color <- c
        | _ -> ()
    
    match seriesD.Marker with
    | None -> ()
    | Some markerD ->
        series.MarkerStyle <- markerStyle markerD.Shape
        series.MarkerSize <- markerD.Size
        series.MarkerStep <- markerD.Step
        match markerD.Color with
        | None -> ()
        | Some c ->
            series.MarkerColor <- c
            series.MarkerBorderWidth <- 1
            series.MarkerBorderColor <- series.Color
    
    match seriesD.Labels with
    | None -> ()
    | Some labelD ->
        match labelD.Format with
        | None -> () | Some f -> series.LabelFormat <- f
        match labelD.Color with
        | None -> () | Some c -> series.LabelForeColor <- c
        match labelD.Font with
        | None -> () | Some (nm, sz, sty) -> series.Font <- new Font(nm, sz, sty)
        match labelD.Angle with
        | None -> ()
        | Some a ->
            series.LabelAngle <- a
            series.SmartLabelStyle.Enabled <- false
        match labelD.Background with
        | Some ( Uniform c ) ->
            series.LabelBackColor <- c
        | _ -> ()
        match labelD.Border with
        | None -> ()
        | Some (s, c, w) ->
            series.LabelBorderDashStyle <- dashStyle s
            series.LabelBorderColor <- c
            series.LabelBorderWidth <- w
    
    match areaD.Legend with
    | None -> series.IsVisibleInLegend <- false
    | Some _ -> series.Legend <- areaName
    
    series.LegendText <- defaultArg seriesD.Text series.Name
    chart.Series.Add series
    
    let toIe v = v :> IEnumerable
    
    let xs =
        match data.DataX with
        | XD d -> d |> toIe
        | XF f -> f |> toIe
        | XS s -> s |> toIe
    
    let ys =
        match data.DataY with
        | [o; h; l; c] -> [h; l; o; c]
        | _ -> data.DataY
    
    series.Points.DataBindXY( xs, ys |> Seq.map toIe |> Seq.toArray )
    
    match data.Labels with
    | None    -> ()
    | Some ls -> series.Points |> Seq.iteri (fun i p -> p.Label <- ls.[i])

let setScaleF (axis : Axis) (axisD : AxisDef) =
    let minv, maxv = axis.Minimum, axis.Maximum
    
    match axisD.Scale with
    | None ->
        axis.RoundAxisValues()
    | Some scale ->
        match scale with
        | Linear(factor, round) ->
            let minv', maxv', step =
                scaleF factor minv maxv
            axis.Interval <- step
            if round then
                axis.Minimum <- minv'
                axis.Maximum <- maxv'
            else
                axis.IntervalOffset <- step * ceil(minv / step) - minv
        | LogLog b ->
            axis.IsLogarithmic <- true
            axis.LogarithmBase <- b
        | LogLin factor ->
            let minv', maxv', step =
                scaleF factor minv maxv
            axis.IsLogarithmic <- true
            axis.LogarithmBase <- 2.0
            axis.Minimum <- if minv' > 0.0 then minv' else minv
            axis.Maximum <- maxv'
            let log2 x = log x / log 2.0
            let first = if minv' > 0.0 then minv' else minv' + step
            let last = maxv' + step
            seq {first .. step .. last}
            |> Seq.pairwise
            |> Seq.iter (fun (x1, x2) ->
                let lx1 = log2 x1
                let lx2 = log2 x2
                let dlx = lx2 - lx1
                let label = x1.ToString(axis.LabelStyle.Format)
                axis.CustomLabels.Add(new CustomLabel(lx1 - dlx, lx1 + dlx, label, 0, LabelMarkStyle.None, GridTickTypes.All))
            )
        | Range(smin, smax, step) ->
            axis.Minimum  <- smin
            axis.Maximum  <- smax
            axis.Interval <- step
        | _ -> ()
    
    match axisD.Crossing with
    | None -> ()
    | Some crossing ->
        match crossing with
        | CrossAtMin moveMarks ->
            axis.Crossing <- System.Double.MinValue
            axis.IsMarksNextToAxis <- moveMarks
        | CrossAtMax moveMarks ->
            axis.Crossing <- System.Double.MaxValue
            axis.IsMarksNextToAxis <- moveMarks
        | CrossAtVal(moveMarks, v) ->
            if (axis.Minimum <= v && v <= axis.Maximum) then
                axis.Crossing <- v
                axis.IsMarksNextToAxis <- moveMarks

let setScaleD (axis : Axis) (axisD : AxisDef) (ds : DateTime[]) =
    
    let filter2Acc p xs =
        Seq.fold
            ( fun acc x ->
                match acc with
                | [] -> [x]
                | h :: t ->
                    match p h x with
                    | false, _     -> acc
                    | true , false -> x :: acc
                    | true , true  -> x :: t )
            []
            xs
        |> List.rev
    
    let setLabels dates =
        
        let setLabel (date : DateTime) prev curr next =
            let delta = float( max 1 (max (curr - prev) (next - curr)) ) / 2.0
            let first, last = float curr - delta, float curr + delta
            let label = match axis.LabelStyle.Format with "" -> "" | fmt -> date.ToString(fmt)
            axis.CustomLabels.Add(new CustomLabel(first, last, label, 0, LabelMarkStyle.None, GridTickTypes.All))
        
        let rec setLabelsAux = function
            | (prev, _)::((curr, date)::(next, _)::_ as rest) ->
                setLabel date prev curr next
                setLabelsAux rest
            | (prev, _)::(curr, date)::[] ->
                setLabel date prev curr curr
            | _ -> ()
        
        let dates =
            match dates with
            | (i1, _)::(i2, _)::(i3, _)::_ when 3*(i2 - i1) < 2*(i3 - i2) -> dates
            | _ -> (List.head dates) :: dates
        
        setLabelsAux dates
    
    match axisD.Scale with
    | Some ( TimeX target ) ->
        let nd = Array.length ds
        let intraday =
            if nd < 3 then true
            else min (ds.[1] - ds.[0]).Ticks (ds.[2] - ds.[1]).Ticks < System.TimeSpan.TicksPerDay
        let sampling = scaleD intraday target nd ds.[0] ds.[nd - 1]
        let dates = ds |> Seq.zip (seq {1 .. nd}) |> filter2Acc sampling
        setLabels dates
    | _ -> ()

let createContents (chart : Chart) (contents : ChartContents) =
    
    let contents = contents.Flatten()
    
    contents
    |> List.iteri (fun areaId ((areaD, content), rect) ->
        let areaName = sprintf "A%d" (areaId + 1)
        let area = createArea chart areaD rect areaName
        
        content |> List.iteri (fun seriesId (seriesD, data : SeriesData) ->
            let seriesName = areaName + (sprintf "S%d" (seriesId + 1))
            data.Check(areaD.TypeX, seriesD.SeriesType.Cardinality)
                |> Option.iter(fun msg -> failwithf "invalid data for series %s : %s" seriesName msg)
            createSeries chart areaD areaName seriesD data seriesName
        )
        
        area.RecalculateAxesScale()
        setScaleF area.AxisY areaD.AxisY
        
        match areaD.AxisY2 with
        | Some axisD -> setScaleF area.AxisY2 axisD
        | _ -> ()
        
        match areaD.TypeX with
        | XString -> ()
        | XFloat  -> setScaleF area.AxisX areaD.AxisX
        | XDate   ->
            match content with
            | (_, data) :: _ ->
                match data.DataX with
                | XD ds -> setScaleD area.AxisX areaD.AxisX ds
                | _ -> ()
            | _ -> ()
    )
    
    contents
    |> List.iteri (fun areaId ((areaD, _), _) ->
        match areaD.AlignTo with
        | Some (Horizontal a as o) | Some (Vertical a as o) ->
            let area = chart.ChartAreas.[sprintf "A%d" (areaId + 1)]
            area.AlignWithChartArea <- a
            area.AlignmentStyle <- AreaAlignmentStyles.PlotPosition
            area.AlignmentOrientation <- orientation o
        | _ -> ()
    )

let displayIn (chart : Chart) (chartD : ChartDef) =
    
    chart.Titles.Clear()
    chart.Series.Clear()
    chart.Legends.Clear()
    chart.ChartAreas.Clear()
    
    setChart chart chartD
    createContents chart chartD.Contents

let display topmost width height chartD =
    
    let getChartAsStream (format : ChartImageFormat) (chart : Chart) =
        let stream = new MemoryStream()
        chart.SaveImage(stream, format)
        stream.Seek(0L, System.IO.SeekOrigin.Begin) |> ignore
        stream
    
    let copyPng chart =
        use stream = getChartAsStream ChartImageFormat.Png chart
        use bmp = new Bitmap(stream)
        Clipboard.SetImage(bmp)
    
    let copyEmf (form : Form) (chart : Chart) =
        use stream = getChartAsStream ChartImageFormat.EmfPlus chart
        use mf = new System.Drawing.Imaging.Metafile(stream)
        MetafileToClipboard.PutEnhMetafileOnClipboard(form.Handle, mf) |> ignore
    
    let save (chart : Chart) =
        let filter =
            "Bitmap (*.bmp)|*.bmp|JPEG (*.jpg)|*.jpg|EMF (*.emf)|*.emf|EMF-Dual (*.emf)|*.emf|EMF+ (*.emf)|*.emf|"
            + "PNG (*.png)|*.png|GIF (*.gif)|*.gif|TIFF (*.tif)|*.tif"
        
        use saveFileDialog =
            new SaveFileDialog(Filter = filter, FilterIndex = 6, RestoreDirectory = true)
        
        if saveFileDialog.ShowDialog() = DialogResult.OK then
            let format =
                match saveFileDialog.FilterIndex with
                    | 1 -> ChartImageFormat.Bmp
                    | 2 -> ChartImageFormat.Jpeg
                    | 3 -> ChartImageFormat.Emf
                    | 4 -> ChartImageFormat.EmfDual
                    | 5 -> ChartImageFormat.EmfPlus
                    | 6 -> ChartImageFormat.Png
                    | 7 -> ChartImageFormat.Gif
                    | 8 -> ChartImageFormat.Tiff
                    | _ -> ChartImageFormat.Png
            
            chart.SaveImage(saveFileDialog.FileName, format)
    
    let form  = new Form(Text = "FSChart", Size = new Size(width, height), TopMost = topmost)
    let chart = new Chart()
    chart.Dock <- DockStyle.Fill
    form.Controls.Add(chart)
    
    let menu = new ContextMenu()
    let miCopyPng = new MenuItem("Copy Png to Clipboard")
    miCopyPng.Shortcut <- Shortcut.CtrlC
    miCopyPng.Click.Add(fun _ -> copyPng chart)
    let miCopyEmf = new MenuItem("Copy Emf to Clipboard")
    miCopyEmf.Shortcut <- Shortcut.CtrlShiftC
    miCopyEmf.Click.Add(fun _ -> copyEmf form chart)
    let miSaveAs  = new MenuItem("Save as ...")
    miSaveAs.Shortcut <- Shortcut.CtrlS
    miSaveAs.Click.Add(fun _ -> save chart)
    menu.MenuItems.AddRange [| miCopyPng; miCopyEmf; miSaveAs |]
    form.ContextMenu <- menu
    
    displayIn chart chartD
    form.Show()
    form, chart

let save (format : ChartImageFormat) width height (filename : string) chartD =
    let chart = new Chart(Size = new Size(width, height))
    displayIn chart chartD
    chart.SaveImage(filename, format)

